GRAPHS
Photo by Taylor Wilcox on Unsplash
nodes <- read.csv("archetypes/uk-government-spending/nodes.csv", header = TRUE, stringsAsFactors = FALSE)
nodes$color <- as.character(paste0("#", nodes$color))
head(nodes, n = 10)
edges <- read.csv("archetypes/uk-government-spending/edges.csv", header = TRUE, stringsAsFactors = FALSE)
edges$color <- as.character(paste0("#", edges$color))
head(edges, n = 10)
# Convert data to graph data frame
# directed=true means it is a flow not just an association between nodes
g <- graph.data.frame(edges, directed=TRUE, vertices=nodes)
g
## IGRAPH 07e20f0 DN-- 107 106 --
## + attr: name (v/c), billion_pounds (v/n), percent (v/n),
## | contribution_per_taxpayer_per_day (v/n), color (v/c), billion_pounds
## | (e/n), percent (e/n), contribution_per_taxpayer_per_day (e/n), color
## | (e/c)
## + edges from 07e20f0 (vertex names):
## [1] Budget ->Incomes
## [2] Incomes ->Taxes on Wealth & Income
## [3] Taxes on Wealth & Income->Income Tax
## [4] Income Tax ->Paye
## [5] Income Tax ->Self Employed
## + ... omitted several edges
df_graph <- g %>%
as_tbl_graph() %>%
activate(edges) %>%
# computes numbers between 0 and 1 according to Number of Student Number
mutate(edge_weights = log10(billion_pounds)/10)
df_graph
## # A tbl_graph: 107 nodes and 106 edges
## #
## # A rooted tree
## #
## # Edge Data: 106 x 7 (active)
## from to billion_pounds percent contribution_per_taxpay~ color edge_weights
## <int> <int> <dbl> <dbl> <dbl> <chr> <dbl>
## 1 1 2 753. 1 0 #4e1~ 0.288
## 2 2 3 221 0.294 0 #944~ 0.234
## 3 3 4 177. 0.236 0 #944~ 0.225
## 4 4 5 146 0.194 0 #944~ 0.216
## 5 4 6 24.3 0.0323 0 #944~ 0.139
## 6 4 7 7 0.00930 0 #944~ 0.0845
## # ... with 100 more rows
## #
## # Node Data: 107 x 5
## name billion_pounds percent contribution_per_taxpay~ color
## <chr> <dbl> <dbl> <dbl> <chr>
## 1 Budget 753. 1 0 #4e1~
## 2 Incomes 753. 1 0 #4e1~
## 3 Taxes on Wealth & Income 221 0.294 0 #944~
## # ... with 104 more rows
## Edge Types
# geom_edge_arc
# geom_edge_arc0
# geom_edge_arc2
# geom_edge_density
# geom_edge_diagonal
# geom_edge_diagonal0
# geom_edge_diagonal2
# geom_edge_elbow
# geom_edge_elbow0
# geom_edge_elbow2
# geom_edge_fan
# geom_edge_fan0
# geom_edge_fan2
# geom_edge_hive
# geom_edge_hive0
# geom_edge_hive2
# geom_edge_link
# geom_edge_link0
# geom_edge_link2
## Layouts can be computationally intensive
# Uncomment only for use
##################
# igraph layouts #
##################
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'bipartite')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'circle')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'dh')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'drl')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'fr')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'gem')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'graphopt')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'grid')
layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'kk')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'lgl')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'mds')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'nicely')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'sphere')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'star')
# layout <- create_layout(df_graph, layout = 'igraph', algorithm = 'sugiyama')
## graphlayouts
# layout <- create_layout(df_graph, layout = "nicely")
# layout <- create_layout(df_graph, layout = "stress")
# layout <- create_layout(df_graph, layout = "focus", focus = 1)
theme_opts <- theme(
legend.position = "none",
legend.title = element_blank(),
axis.text = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background=element_rect(fill="white", colour="white"),
panel.border = element_blank(),
plot.background = element_blank(),
)
colors <- unique(E(df_graph)$color)
color_palette <- c( colors )
color_palette
## [1] "#4e1c12" "#944b36" "#5f0801" "#b37b65" "#999999" "#e6e6e6" "#9acdaa"
## [8] "#46a49d" "#6ab6ad" "#56827a" "#87a38e" "#326965" "#7f7f7f"
v1 <- ggraph(layout) +
geom_edge_elbow(aes(edge_width = edge_weights, color = color)) + # aes(edge_width = edge_weights)
geom_node_point(aes(size=billion_pounds, color = color)) +
geom_node_label( aes(label=name, fill = color), color = "white", repel = FALSE, vjust = -0.5, hjust = 0.5, size = 4, family = "inconsolata") +
scale_size_continuous(range = c(1, 12)) +
scale_color_manual(values = color_palette) +
coord_fixed(clip = 'off') +
theme_graph()+
theme_opts
girafe(ggobj = v1, width_svg = 16, height_svg = 14,
options = list(opts_sizing(rescale = TRUE, width = 1.0)))
Source: